Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbmidi / vb_seq.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-02-04 | 50.0 KB | 1,498 lines

VERSION 2.00 Begin Form frmVBSeq BackColor = &H00C0C0C0& BorderStyle = 3 'Fixed Double Caption = "VB Sequencer" ClientHeight = 5160 ClientLeft = 3735 ClientTop = 2235 ClientWidth = 3930 Height = 5850 Icon = VB_SEQ.FRX:0000 KeyPreview = -1 'True Left = 3675 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 5160 ScaleWidth = 3930 Top = 1605 Width = 4050 Begin CommonDialog dlgFileDialog Left = 3270 Top = 5490 End Begin Timer tmrActualize Interval = 111 Left = 1740 Top = 6120 End Begin SSPanel Z BevelInner = 1 'Inset BevelOuter = 0 'None BevelWidth = 2 BorderWidth = 1 ForeColor = &H00FF0000& Height = 1455 Index = 3 Left = 90 TabIndex = 33 Top = 1350 Width = 3765 Begin SSPanel Z BevelOuter = 0 'None Caption = "Program" Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 195 Index = 14 Left = 2340 TabIndex = 50 Top = 720 Width = 855 End Begin SSCommand cmdProgDecr Font3D = 3 'Inset w/light shading ForeColor = &H00FF0000& Height = 405 Left = 3030 Outline = 0 'False Picture = VB_SEQ.FRX:0302 TabIndex = 49 Top = 930 Width = 345 End Begin SSCommand cmdProgIncr Font3D = 3 'Inset w/light shading ForeColor = &H00FF0000& Height = 405 Left = 2160 Outline = 0 'False Picture = VB_SEQ.FRX:0604 TabIndex = 48 Top = 930 Width = 345 End Begin SSCommand cmdChanIncr Font3D = 3 'Inset w/light shading ForeColor = &H00FF0000& Height = 405 Left = 390 Outline = 0 'False Picture = VB_SEQ.FRX:0906 TabIndex = 45 Top = 930 Width = 345 End Begin SSCommand cmdChanDecr Font3D = 3 'Inset w/light shading ForeColor = &H00FF0000& Height = 405 Left = 1260 Outline = 0 'False Picture = VB_SEQ.FRX:0C08 TabIndex = 44 Top = 930 Width = 345 End Begin SSPanel Z BevelOuter = 0 'None Caption = "Channel" Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 195 Index = 1 Left = 630 TabIndex = 43 Top = 720 Width = 765 End Begin SSPanel pnlFileName BevelOuter = 0 'None BevelWidth = 3 BorderWidth = 0 Caption = "FILE : ?" Font3D = 2 'Raised w/heavy shading FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000080& Height = 240 Left = 270 TabIndex = 38 Top = 60 Width = 3195 End Begin SSPanel lblRecMesNum Alignment = 1 'Left Justify - MIDDLE BevelOuter = 0 'None BorderWidth = 1 Caption = "0" Font3D = 3 'Inset w/light shading ForeColor = &H00FF0000& Height = 195 Left = 2430 TabIndex = 36 Top = 390 Width = 825 End Begin SSPanel lblRecMesText Alignment = 4 'Right Justify - MIDDLE BevelOuter = 0 'None BorderWidth = 1 Caption = "MIDI Messages =" Font3D = 3 'Inset w/light shading ForeColor = &H00FF0000& Height = 195 Left = 810 TabIndex = 37 Top = 390 Width = 1545 End Begin Label lblProgram Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "0" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 285 Left = 2520 TabIndex = 47 Top = 990 Width = 495 End Begin Label lblChannel Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "1" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 285 Left = 750 TabIndex = 46 Top = 990 Width = 495 End End Begin SSCommand cmdStopUp BevelWidth = 0 Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 510 Left = 120 Outline = 0 'False Picture = VB_SEQ.FRX:0F0A TabIndex = 20 TabStop = 0 'False Top = 5460 Visible = 0 'False Width = 510 End Begin SSCommand cmdPlayUp BevelWidth = 0 Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 510 Left = 630 Outline = 0 'False Picture = VB_SEQ.FRX:120C TabIndex = 19 TabStop = 0 'False Top = 5460 Visible = 0 'False Width = 510 End Begin SSCommand cmdRecUp BevelWidth = 0 Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 510 Left = 1140 Outline = 0 'False Picture = VB_SEQ.FRX:150E TabIndex = 18 TabStop = 0 'False Top = 5460 Visible = 0 'False Width = 510 End Begin SSCommand cmdStopDn BevelWidth = 0 Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 510 Left = 1650 Outline = 0 'False Picture = VB_SEQ.FRX:1810 TabIndex = 17 TabStop = 0 'False Top = 5460 Visible = 0 'False Width = 510 End Begin SSCommand cmdPlayDn BevelWidth = 0 Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 510 Left = 2160 Outline = 0 'False Picture = VB_SEQ.FRX:1B12 TabIndex = 16 TabStop = 0 'False Top = 5460 Visible = 0 'False Width = 510 End Begin SSCommand cmdRecDn BevelWidth = 0 Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 510 Left = 2670 Outline = 0 'False Picture = VB_SEQ.FRX:1E14 TabIndex = 15 TabStop = 0 'False Top = 5460 Visible = 0 'False Width = 495 End Begin SSPanel Z Alignment = 6 'Center - TOP BevelInner = 1 'Inset BevelOuter = 0 'None BevelWidth = 2 BorderWidth = 1 Caption = "MIDI DEVICES" Font3D = 2 'Raised w/heavy shading FontBold = -1 'True FontItalic = 0 'False FontName = "Arial" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000080& Height = 1185 Index = 6 Left = 90 TabIndex = 10 Top = 90 Width = 3765 Begin PictureBox picDataOut AutoRedraw = -1 'True BackColor = &H00000080& BorderStyle = 0 'None ClipControls = 0 'False Height = 190 Left = 510 Picture = VB_SEQ.FRX:2116 ScaleHeight = 195 ScaleWidth = 195 TabIndex = 40 Top = 840 Width = 190 End Begin PictureBox picDataIn AutoRedraw = -1 'True BackColor = &H00000080& BorderStyle = 0 'None ClipControls = 0 'False Height = 190 Left = 510 Picture = VB_SEQ.FRX:2418 ScaleHeight = 195 ScaleWidth = 195 TabIndex = 39 Top = 450 Width = 190 End Begin SSPanel Z BevelOuter = 0 'None BorderWidth = 1 Caption = "OUT" Font3D = 3 'Inset w/light shading FontBold = -1 'True FontItalic = 0 'False FontName = "Arial" FontSize = 6.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00FF0000& Height = 180 Index = 2 Left = 90 TabIndex = 14 Top = 840 Width = 375 End Begin SSPanel Z BevelOuter = 0 'None BorderWidth = 1 Caption = "IN" Font3D = 3 'Inset w/light shading FontBold = -1 'True FontItalic = 0 'False FontName = "Arial" FontSize = 6.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00FF0000& Height = 180 Index = 0 Left = 180 TabIndex = 13 Top = 450 Width = 225 End Begin SSPanel Z AutoSize = 3 'AutoSize Child To Panel BevelInner = 1 'Inset BevelOuter = 0 'None BevelWidth = 2 BorderWidth = 0 ForeColor = &H00FF0000& Height = 360 Index = 8 Left = 780 TabIndex = 12 Top = 750 Width = 2900 Begin ComboBox cboMidiOut Height = 300 Left = 30 Style = 2 'Dropdown List TabIndex = 28 Top = 30 Width = 2835 End End Begin SSPanel Z AutoSize = 3 'AutoSize Child To Panel BevelInner = 1 'Inset BevelOuter = 0 'None BevelWidth = 2 BorderWidth = 0 ForeColor = &H00FF0000& Height = 360 Index = 7 Left = 780 TabIndex = 11 Top = 360 Width = 2900 Begin ComboBox cboMidiIn Height = 300 Left = 30 Style = 2 'Dropdown List TabIndex = 27 Top = 30 Width = 2835 End End End Begin SSPanel pnlMTC Alignment = 6 'Center - TOP BevelInner = 1 'Inset BevelOuter = 0 'None BevelWidth = 2 BorderWidth = 1 Caption = "MTC : 25 f/s" Font3D = 2 'Raised w/heavy shading FontBold = -1 'True FontItalic = 0 'False FontName = "Arial" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000080& Height = 2175 Left = 90 TabIndex = 0 Top = 2880 Width = 3765 Begin SSPanel pnlDebug BevelInner = 1 'Inset BevelOuter = 0 'None BevelWidth = 3 BorderWidth = 0 Caption = "D" Font3D = 3 'Inset w/light shading ForeColor = &H00FF0000& Height = 250 Left = 3360 TabIndex = 51 Top = 1770 Visible = 0 'False Width = 250 End Begin PictureBox picMtcOut AutoRedraw = -1 'True BackColor = &H00000080& BorderStyle = 0 'None ClipControls = 0 'False Height = 190 Left = 2910 Picture = VB_SEQ.FRX:271A ScaleHeight = 195 ScaleWidth = 195 TabIndex = 42 Top = 500 Width = 190 End Begin PictureBox picMtcIn AutoRedraw = -1 'True BackColor = &H00000080& BorderStyle = 0 'None ClipControls = 0 'False Height = 190 Left = 630 Picture = VB_SEQ.FRX:2A1C ScaleHeight = 195 ScaleWidth = 195 TabIndex = 41 Top = 500 Width = 190 End Begin SSPanel Z BevelOuter = 0 'None BorderWidth = 1 Caption = "OUT" Font3D = 3 'Inset w/light shading FontBold = -1 'True FontItalic = 0 'False FontName = "Arial" FontSize = 6.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00FF0000& Height = 180 Index = 13 Left = 2820 TabIndex = 35 Top = 315 Width = 375 End Begin SSPanel Z BevelOuter = 0 'None BorderWidth = 1 Caption = "IN" Font3D = 3 'Inset w/light shading FontBold = -1 'True FontItalic = 0 'False FontName = "Arial" FontSize = 6.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00FF0000& Height = 195 Index = 12 Left = 610 TabIndex = 34 Top = 315 Width = 225 End Begin SSPanel Z BevelInner = 2 'Raised BevelOuter = 0 'None BorderWidth = 0 ForeColor = &H00FF0000& Height = 435 Index = 10 Left = 1020 TabIndex = 31 Top = 1590 Width = 1680 Begin SSPanel Z AutoSize = 3 'AutoSize Child To Panel BevelInner = 1 'Inset BevelOuter = 0 'None BevelWidth = 2 BorderWidth = 0 ForeColor = &H00FF0000& Height = 315 Index = 11 Left = 760 TabIndex = 29 Top = 60 Width = 855 Begin Label lblSync Alignment = 2 'Center BackColor = &H00FFFFFF& BorderStyle = 1 'Fixed Single Caption = "Internal" ForeColor = &H00800000& Height = 255 Left = 30 TabIndex = 30 Top = 30 Width = 795 End End Begin SSCommand cmdSync Caption = "&Sync" Font3D = 3 'Inset w/light shading ForeColor = &H00800000& Height = 315 Left = 60 TabIndex = 32 Top = 60 Width = 645 End End Begin SSPanel Z Alignment = 0 'Left Justify - TOP AutoSize = 3 'AutoSize Child To Panel BevelInner = 2 'Raised BorderWidth = 1 Font3D = 3 'Inset w/light shading ForeColor = &H00FF0000& Height = 640 Index = 9 Left = 240 TabIndex = 21 Top = 870 Width = 3230 Begin SSCommand cmdRewind Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 510 Left = 1590 Picture = VB_SEQ.FRX:2D1E TabIndex = 26 TabStop = 0 'False Top = 60 Width = 800 End Begin SSCommand cmdForward Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 510 Left = 2370 Picture = VB_SEQ.FRX:3308 TabIndex = 25 TabStop = 0 'False Top = 60 Width = 800 End Begin SSCommand cmdStop BevelWidth = 0 Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 510 Left = 60 Picture = VB_SEQ.FRX:3922 TabIndex = 24 TabStop = 0 'False Top = 60 Width = 510 End Begin SSCommand cmdPlay BevelWidth = 0 Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 510 Left = 570 Picture = VB_SEQ.FRX:3C24 TabIndex = 23 TabStop = 0 'False Top = 60 Width = 510 End Begin SSCommand cmdRec BevelWidth = 0 Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 510 Left = 1080 Picture = VB_SEQ.FRX:3F26 TabIndex = 22 TabStop = 0 'False Top = 60 Width = 510 End End Begin SSPanel Z BevelInner = 2 'Raised BevelOuter = 0 'None BevelWidth = 2 BorderWidth = 0 Height = 450 Index = 5 Left = 1110 TabIndex = 1 Top = 360 Width = 1485 Begin SSPanel Z BevelInner = 1 'Inset BevelOuter = 0 'None BevelWidth = 3 BorderWidth = 0 Height = 330 Index = 4 Left = 60 TabIndex = 2 Top = 60 Width = 1365 Begin Label lblHours Alignment = 2 'Center BackColor = &H00000000& Caption = "00" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Left = 30 TabIndex = 9 Top = 30 Width = 300 End Begin Label lblMinutes Alignment = 2 'Center BackColor = &H00000000& Caption = "00" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Left = 410 TabIndex = 8 Top = 30 Width = 225 End Begin Label lblSeconds Alignment = 2 'Center BackColor = &H00000000& Caption = "00" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Left = 740 TabIndex = 7 Top = 30 Width = 225 End Begin Label lblFrames Alignment = 2 'Center BackColor = &H00000000& Caption = "00" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Left = 1040 TabIndex = 6 Top = 30 Width = 270 End Begin Label lblSep Alignment = 2 'Center BackColor = &H00000000& Caption = ":" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Index = 0 Left = 320 TabIndex = 5 Top = 30 Width = 90 End Begin Label lblSep Alignment = 2 'Center BackColor = &H00000000& Caption = ":" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Index = 1 Left = 630 TabIndex = 4 Top = 30 Width = 105 End Begin Label lblSep Alignment = 2 'Center BackColor = &H00000000& Caption = ":" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Index = 2 Left = 960 TabIndex = 3 Top = 30 Width = 105 End End End End Begin Menu mnuFile Caption = "&File" Begin Menu mnuFileAbout Caption = "&About..." End Begin Menu mnuFileSep1 Caption = "-" End Begin Menu mnuFileNew Caption = "&New" End Begin Menu mnuFileOpen Caption = "&Open..." End Begin Menu mnuFileSave Caption = "&Save..." End Begin Menu mnuFileSep2 Caption = "-" End Begin Menu mnuFileExit Caption = "&Exit" End End Begin Menu mnuOptions Caption = "&Options" Begin Menu mnuOptionsMidiThru Caption = "&Midi Data Thru (Always)" Checked = -1 'True End Begin Menu mnuOptionsMtcThru Caption = "M&TC Thru (Always)" Checked = -1 'True End Begin Menu mnuOptionsMtcOut Caption = "MT&C Out (Internal Sync)" Checked = -1 'True End Begin Menu mnuOptionsSep1 Caption = "-" End Begin Menu mnuOptionsFrameMode Caption = "&Frame Mode" Begin Menu mnuOptionsFrameModeSet Caption = "24" Index = 0 End Begin Menu mnuOptionsFrameModeSet Caption = "25" Checked = -1 'True Index = 1 End Begin Menu mnuOptionsFrameModeSet Caption = "30Drop" Index = 2 End Begin Menu mnuOptionsFrameModeSet Caption = "30NoDrop" Index = 3 End End End Begin Menu mnuVisual Caption = "&Visualize" Begin Menu mnuVisualClock Caption = "&Clock" Checked = -1 'True End Begin Menu mnuVisualData Caption = "&Data Flow" Checked = -1 'True End Begin Menu mnuVisualMTC Caption = "&MTC Flow" Checked = -1 'True End Begin Menu mnuVisualSep1 Caption = "-" End Begin Menu mnuVisualAll Caption = "&All" End Begin Menu mnuVisualNone Caption = "&None" End End Option Explicit Sub cboMidiIn_Click () If cboMidiIn.ListIndex = 0 Then Call MidiIn_Close Else Call MidiIn_Open(cboMidiIn.ListIndex - 1) End If cmdSync.SetFocus End Sub Sub cboMidiOut_Click () If cboMidiOut.ListIndex = 0 Then Call MidiOut_Close Else 'First Device is MIDI Mapper (-1) Call MidiOut_Open(cboMidiOut.ListIndex - 2) End If cmdSync.SetFocus End Sub Sub cmdChanDecr_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) If bStop = False Then nSeqChannel = nSeqChannel - 1 If nSeqChannel < 0 Then nSeqChannel = 0 lblChannel = CStr(nSeqChannel + 1) Else nSeqChannel = Label_Decrement(lblChannel, 1, 1) - 1 End If vntRet = MidiOut_ProgramChange(nSeqChannel, aSeqProgram(nSeqChannel)) lblProgram = CStr(aSeqProgram(nSeqChannel)) cmdSync.SetFocus End Sub Sub cmdChanDecr_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) bMouseDown = False End Sub Sub cmdChanIncr_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) If bStop = False Then nSeqChannel = nSeqChannel + 1 If nSeqChannel > 15 Then nSeqChannel = 15 lblChannel = CStr(nSeqChannel + 1) Else 'Show 1...16 (really 0...15) nSeqChannel = Label_Increment(lblChannel, 16, 1) - 1 End If vntRet = MidiOut_ProgramChange(nSeqChannel, aSeqProgram(nSeqChannel)) lblProgram = CStr(aSeqProgram(nSeqChannel)) cmdSync.SetFocus End Sub Sub cmdChanIncr_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) bMouseDown = False End Sub Sub cmdForward_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim bFirst As Integer If bStop = False Then cmdSync.SetFocus Exit Sub End If bFirst = True bMouseDown = True Do While bMouseDown = True Select Case Shift Case 0: nDisplayFrames = nDisplayFrames + 1 Case ALT_MASK: nDisplaySeconds = nDisplaySeconds + 1 Case CTRL_MASK: nDisplayMinutes = nDisplayMinutes + 1 Case SHIFT_MASK: nDisplayHours = nDisplayHours + 1 End Select Call Mtc_Adjust(nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames) Display_Show If bFirst = True Then 'First Loop cycle bFirst = False Wait_DoEvents (200) Else 'Key Repeat Wait_DoEvents (10) End If Loop cmdSync.SetFocus End Sub Sub cmdForward_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) bMouseDown = False End Sub Sub cmdPlay_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) cmdSync.SetFocus Call Start_Play End Sub Sub cmdProgDecr_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) If bStop = False Then aSeqProgram(nSeqChannel) = aSeqProgram(nSeqChannel) - 1 If aSeqProgram(nSeqChannel) < 0 Then aSeqProgram(nSeqChannel) = 0 vntRet = MidiOut_ProgramChange(nSeqChannel, aSeqProgram(nSeqChannel)) lblProgram = CStr(aSeqProgram(nSeqChannel)) Else aSeqProgram(nSeqChannel) = Label_Decrement(lblProgram, 0, 1) vntRet = MidiOut_ProgramChange(nSeqChannel, aSeqProgram(nSeqChannel)) End If cmdSync.SetFocus End Sub Sub cmdProgDecr_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) bMouseDown = False End Sub Sub cmdProgIncr_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) If bStop = False Then aSeqProgram(nSeqChannel) = aSeqProgram(nSeqChannel) + 1 If aSeqProgram(nSeqChannel) > 127 Then aSeqProgram(nSeqChannel) = 127 vntRet = MidiOut_ProgramChange(nSeqChannel, aSeqProgram(nSeqChannel)) lblProgram = CStr(aSeqProgram(nSeqChannel)) Else aSeqProgram(nSeqChannel) = Label_Increment(lblProgram, 127, 1) vntRet = MidiOut_ProgramChange(nSeqChannel, aSeqProgram(nSeqChannel)) End If cmdSync.SetFocus End Sub Sub cmdProgIncr_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) bMouseDown = False End Sub Sub cmdRec_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) cmdSync.SetFocus Call Start_Rec End Sub Sub cmdRewind_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim bFirst As Integer If bStop = False Then cmdSync.SetFocus Exit Sub End If bFirst = True bMouseDown = True Do While bMouseDown = True Select Case Shift Case 0: nDisplayFrames = nDisplayFrames - 1 Case ALT_MASK: nDisplaySeconds = nDisplaySeconds - 1 Case CTRL_MASK: nDisplayMinutes = nDisplayMinutes - 1 Case SHIFT_MASK: nDisplayHours = nDisplayHours - 1 End Select Call Mtc_Adjust(nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames) Display_Show If bFirst = True Then 'First Loop cycle bFirst = False Wait_DoEvents (200) Else 'Key Repeat Wait_DoEvents (20) End If Loop cmdSync.SetFocus End Sub Sub cmdRewind_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) bMouseDown = False End Sub Sub cmdStop_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) cmdSync.SetFocus bStop = True End Sub Sub cmdSync_Click () If bStop = False Then Exit Sub If lblSync.Caption = "Internal" Then lblSync.Caption = "External" nSyncMode = SYNC_EXTERNAL lblSync.BackColor = DARKBLUE lblSync.ForeColor = WHITE Else lblSync.Caption = "Internal" nSyncMode = SYNC_INTERNAL lblSync.BackColor = WHITE lblSync.ForeColor = DARKBLUE End If End Sub Sub Form_KeyDown (KeyCode As Integer, Shift As Integer) Dim sh As String, sm As String, ss As String, sf As String If KeyCode = KEY_RETURN Then Start_Play ElseIf KeyCode = KEY_MULTIPLY Then Start_Rec ElseIf KeyCode = KEY_SPACE Then bStop = True ElseIf bStop = True And KeyCode = KEY_ESCAPE Then '->00:00:00:00 nDisplayHours = 0 nDisplayMinutes = 0 nDisplaySeconds = 0 nDisplayFrames = 0 Call Display_Show ElseIf bStop = True And KeytoNum(KeyCode) <> -1 Then 'It's a Number Key sh = lblHours sm = lblMinutes ss = lblSeconds sf = lblFrames 'Shift Clock Display one digit to the left Mid$(sh, 1, 1) = Mid$(sh, 2, 1) 'hh:mm:ss:ff -> hm:ms:sf:fx Mid$(sh, 2, 1) = Mid$(sm, 1, 1) Mid$(sm, 1, 1) = Mid$(sm, 2, 1) Mid$(sm, 2, 1) = Mid$(ss, 1, 1) Mid$(ss, 1, 1) = Mid$(ss, 2, 1) Mid$(ss, 2, 1) = Mid$(sf, 1, 1) Mid$(sf, 1, 1) = Mid$(sf, 2, 1) Mid$(sf, 2, 1) = CStr(KeytoNum(KeyCode)) 'New digit at the right end nDisplayHours = Val(sh) nDisplayMinutes = Val(sm) nDisplaySeconds = Val(ss) nDisplayFrames = Val(sf) Call Display_Show ElseIf KeyCode = KEY_F12 Then 'change debug mode If bDebug = False Then pnlDebug.Visible = True bDebug = True Else pnlDebug.Visible = False bDebug = False End If End If KeyCode = 0 End Sub Sub Form_Load () Dim i As Integer 'Center and Show form Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2 Me.Show 'Load MidiHook form without showing it Load frmMidiHook 'Set Midi handles to closed state hMidiIn = NO_HANDLE hMidiOut = NO_HANDLE 'Fill Devices Lists with existing Midi Devices Call Midi_Populate_Lists(Me.cboMidiIn, Me.cboMidiOut) 'Recall your standard MIDI configuration Call MyIni_Read 'Reset Play flags bStop = True bPlay = False bRec = False 'Reset Rec buffer nRecCounter = 0 Erase aRecBuffer 'Reset name of recorded file sFileName = "?" 'Reset debugging flag bDebug = False End Sub Sub Form_Unload (Cancel As Integer) Call MyIni_Write Call MidiIn_Close Call MidiOut_Close Call Midi_Panic End End Sub Sub lblSync_Click () If bStop = False Then Exit Sub If lblSync.Caption = "Internal" Then lblSync.Caption = "External" nSyncMode = SYNC_EXTERNAL lblSync.BackColor = DARKBLUE lblSync.ForeColor = WHITE Else lblSync.Caption = "Internal" nSyncMode = SYNC_INTERNAL lblSync.BackColor = WHITE lblSync.ForeColor = DARKBLUE End If End Sub Sub mnuFileAbout_Click () frmAbout.Show 1 End Sub Sub mnuFileExit_Click () Call MyIni_Write Call MidiIn_Close Call MidiOut_Close Call Midi_Panic End End Sub Sub mnuFileNew_Click () 'If buffer not empty confirm loss of data If nRecCounter > 0 Then If Dlg_YesNo("Erase recorded MIDI messages?") = False Then Exit Sub End If 'Prepare Rec buffer array nRecCounter = 0 Erase aRecBuffer 'Display new recorded messages counter frmVBSeq.lblRecMesNum = "0" End Sub Sub mnuFileOpen_Click () File_Open End Sub Sub mnuFileSave_Click () File_Save End Sub Sub mnuOptionsFrameModeSet_Click (Index As Integer) Dim i As Integer For i = 0 To 3 mnuOptionsFrameModeSet(i).Checked = False Next i mnuOptionsFrameModeSet(Index).Checked = True pnlMTC.Caption = "MTC : " & Mtc_SetMode(Index) End Sub Sub mnuOptionsMidiThru_Click () If mnuOptionsMidiThru.Checked = True Then mnuOptionsMidiThru.Checked = False bMidiThru = False Else mnuOptionsMidiThru.Checked = True bMidiThru = True End If End Sub Sub mnuOptionsMtcOut_Click () If mnuOptionsMtcOut.Checked = True Then mnuOptionsMtcOut.Checked = False bMtcOut = False Else mnuOptionsMtcOut.Checked = True bMtcOut = True End If End Sub Sub mnuOptionsMtcThru_Click () If mnuOptionsMtcThru.Checked = True Then mnuOptionsMtcThru.Checked = False bMtcThru = False Else mnuOptionsMtcThru.Checked = True bMtcThru = True End If End Sub Sub mnuVisualAll_Click () mnuVisualClock.Checked = True mnuVisualData.Checked = True mnuVisualMtc.Checked = True bVisualClock = True bVisualData = True bVisualMtc = True End Sub Sub mnuVisualClock_Click () If mnuVisualClock.Checked = True Then mnuVisualClock.Checked = False bVisualClock = False Else mnuVisualClock.Checked = True bVisualClock = True End If End Sub Sub mnuVisualData_Click () If mnuVisualData.Checked = True Then mnuVisualData.Checked = False bVisualData = False Else mnuVisualData.Checked = True bVisualData = True End If End Sub Sub mnuVisualMTC_Click () If mnuVisualMtc.Checked = True Then mnuVisualMtc.Checked = False bVisualMtc = False Else mnuVisualMtc.Checked = True bVisualMtc = True End If End Sub Sub mnuVisualNone_Click () mnuVisualClock.Checked = False mnuVisualData.Checked = False mnuVisualMtc.Checked = False bVisualClock = False bVisualData = False bVisualMtc = False End Sub Sub MyIni_Read () Dim sIniName As String Dim sSection As String Dim sParamName As String Dim sRet As String Dim i As Integer sIniName = "VB_SEQ.INI" sSection = "DEVICES" sParamName = "In" sRet = Ini_Read(sIniName, sSection, sParamName) If sRet = "" Or cboMidiIn.ListCount <= Val(sRet) Then 'Open last Midi In Device cboMidiIn.ListIndex = cboMidiIn.ListCount - 1 Else cboMidiIn.ListIndex = Val(sRet) End If sParamName = "Out" sRet = Ini_Read(sIniName, sSection, sParamName) If sRet = "" Or cboMidiOut.ListCount <= Val(sRet) Then 'Open last Midi In Device cboMidiOut.ListIndex = cboMidiOut.ListCount - 1 Else cboMidiOut.ListIndex = Val(sRet) End If sSection = "MTC" sParamName = "Mode" sRet = Ini_Read(sIniName, sSection, sParamName) If sRet = "" Then mnuOptionsFrameModeSet_Click (1) '25 f/s Else mnuOptionsFrameModeSet_Click (Val(sRet)) End If sParamName = "Sync" sRet = Ini_Read(sIniName, sSection, sParamName) If sRet = "" Or sRet = "Internal" Then lblSync.Caption = "Internal" nSyncMode = SYNC_INTERNAL lblSync.BackColor = WHITE lblSync.ForeColor = DARKBLUE Else lblSync.Caption = "External" nSyncMode = SYNC_EXTERNAL lblSync.BackColor = DARKBLUE lblSync.ForeColor = WHITE End If sSection = "OPTIONS" sParamName = "MidiThru" sRet = Ini_Read(sIniName, sSection, sParamName) If sRet = "" Or sRet = "Yes" Then mnuOptionsMidiThru.Checked = True bMidiThru = True Else mnuOptionsMidiThru.Checked = False bMidiThru = False End If sParamName = "MtcThru" sRet = Ini_Read(sIniName, sSection, sParamName) If sRet = "" Or sRet = "Yes" Then mnuOptionsMtcThru.Checked = True bMtcThru = True Else mnuOptionsMtcThru.Checked = False bMtcThru = False End If sParamName = "MtcOut" sRet = Ini_Read(sIniName, sSection, sParamName) If sRet = "" Or sRet = "Yes" Then mnuOptionsMtcOut.Checked = True bMtcOut = True Else mnuOptionsMtcOut.Checked = False bMtcOut = False End If sSection = "VISUALIZE" sParamName = "Clock" sRet = Ini_Read(sIniName, sSection, sParamName) If sRet = "" Or sRet = "Yes" Then mnuVisualClock.Checked = True bVisualClock = True Else mnuVisualClock.Checked = False bVisualClock = False End If sParamName = "MidiData" sRet = Ini_Read(sIniName, sSection, sParamName) If sRet = "" Or sRet = "Yes" Then mnuVisualData.Checked = True bVisualData = True Else mnuVisualData.Checked = False bVisualData = False End If sParamName = "MTC" sRet = Ini_Read(sIniName, sSection, sParamName) If sRet = "" Or sRet = "Yes" Then mnuVisualMtc.Checked = True bVisualMtc = True Else mnuVisualMtc.Checked = False bVisualMtc = False End If sSection = "SEQUENCER" sParamName = "Channel" sRet = Ini_Read(sIniName, sSection, sParamName) nSeqChannel = Val(sRet) lblChannel = CStr(nSeqChannel + 1) sParamName = "Program" For i = 0 To 15 sParamName = sParamName & CStr(i) sRet = Ini_Read(sIniName, sSection, sParamName) aSeqProgram(i) = Val(sRet) Next i lblProgram = CStr(aSeqProgram(nSeqChannel)) End Sub Sub MyIni_Write () Dim sIniName As String Dim sSection As String Dim sParamName As String Dim sParamValue As String Dim i As Integer sIniName = "VB_SEQ.INI" sSection = "DEVICES" sParamName = "In" sParamValue = CStr(frmVBSeq.cboMidiIn.ListIndex) Call Ini_Write(sIniName, sSection, sParamName, sParamValue) sParamName = "Out" sParamValue = CStr(frmVBSeq.cboMidiOut.ListIndex) Call Ini_Write(sIniName, sSection, sParamName, sParamValue) sSection = "MTC" sParamName = "Mode" sParamValue = CStr(nMtcMode) Call Ini_Write(sIniName, sSection, sParamName, sParamValue) sParamName = "Sync" If nSyncMode = SYNC_INTERNAL Then sParamValue = "Internal" Else sParamValue = "External" End If Call Ini_Write(sIniName, sSection, sParamName, sParamValue) sSection = "OPTIONS" sParamName = "MidiThru" If bMidiThru = True Then sParamValue = "Yes" Else sParamValue = "No" End If Call Ini_Write(sIniName, sSection, sParamName, sParamValue) sParamName = "MtcThru" If bMtcThru = True Then sParamValue = "Yes" Else sParamValue = "No" End If Call Ini_Write(sIniName, sSection, sParamName, sParamValue) sParamName = "MtcOut" If bMtcOut = True Then sParamValue = "Yes" Else sParamValue = "No" End If Call Ini_Write(sIniName, sSection, sParamName, sParamValue) sSection = "VISUALIZE" sParamName = "Clock" If bVisualClock = True Then sParamValue = "Yes" Else sParamValue = "No" End If Call Ini_Write(sIniName, sSection, sParamName, sParamValue) sParamName = "MidiData" If bVisualData = True Then sParamValue = "Yes" Else sParamValue = "No" End If Call Ini_Write(sIniName, sSection, sParamName, sParamValue) sParamName = "MTC" If bVisualMtc = True Then sParamValue = "Yes" Else sParamValue = "No" End If Call Ini_Write(sIniName, sSection, sParamName, sParamValue) sSection = "SEQUENCER" sParamName = "Channel" sParamValue = CStr(nSeqChannel) Call Ini_Write(sIniName, sSection, sParamName, sParamValue) sParamName = "Program" For i = 0 To 15 sParamName = sParamName & CStr(i) sParamValue = CStr(aSeqProgram(i)) Call Ini_Write(sIniName, sSection, sParamName, sParamValue) Next i End Sub Sub Start_Play () mnuFile.Enabled = False mnuOptions.Enabled = False mnuVisual.Enabled = False cboMidiIn.Enabled = False cboMidiOut.Enabled = False If nSyncMode = SYNC_INTERNAL Then Call Play_Internal Else Call Play_External End If cboMidiIn.Enabled = True cboMidiOut.Enabled = True mnuFile.Enabled = True mnuOptions.Enabled = True mnuVisual.Enabled = True End Sub Sub Start_Rec () 'If already playing or recording -> do nothing If bStop = False Then Exit Sub 'If buffer not empty confirm loss of data If nRecCounter > 0 Then If Dlg_YesNo("Erase recorded MIDI messages?") = False Then Exit Sub End If sFileName = "?" mnuFile.Enabled = False mnuOptions.Enabled = False mnuVisual.Enabled = False cboMidiIn.Enabled = False cboMidiOut.Enabled = False If nSyncMode = SYNC_INTERNAL Then Call Rec_Internal Else Call Rec_External End If cboMidiIn.Enabled = True cboMidiOut.Enabled = True mnuFile.Enabled = True mnuOptions.Enabled = True mnuVisual.Enabled = True End Sub Sub tmrActualize_Timer () Dim sFname As String Dim lTime As Long 'Current system time lTime = timeGetTime() 'Check if leds must be switched off '(250 ms. elapsed since switch on time) If picMtcIn.BackColor = LED_ON Then If lTime - lMtcInTime >= 250 Then picMtcIn.BackColor = LED_OFF End If End If If picMtcOut.BackColor = LED_ON Then If lTime - lMtcOutTime >= 250 Then picMtcOut.BackColor = LED_OFF End If End If If picDataIn.BackColor = LED_ON Then If lTime - lDataInTime >= 250 Then picDataIn.BackColor = LED_OFF End If End If If picDataOut.BackColor = LED_ON Then If lTime - lDataOutTime >= 250 Then picDataOut.BackColor = LED_OFF End If End If 'Update FileName sFname = "FILE : " & sFileName If pnlFileName.Caption <> sFname Then pnlFileName.Caption = sFname End If End Sub